Option Explicit
Sub Q_Sample019()
    'ոQ_Data01
    ']wޥζMicrosoft Scripting Runtime
    Dim myDic As Scripting.Dictionary
    Dim myRng As Range
    Dim myItems As Variant
    Dim I As Long
    Set myDic = CreateObject("Scripting.Dictionary")
    'wƽd
    For Each myRng In Worksheets("Q_Data01").Range("a1") _
        .CurrentRegion.Columns(3).Offset(1).Cells
        With myRng
            If Len(.Text) > 0 Then
                myDic.Add Key:=myRng.Value, Item:=myRng.Offset(, 6).Value
            End If
        End With
    Next
    myItems = myDic.Items
    For I = LBound(myItems) To UBound(myItems)
        Debug.Print I, myItems(I)
    Next

    Set myDic = Nothing                                   '
End Sub
